home *** CD-ROM | disk | FTP | other *** search
/ POINT Software Programming / PPROG1.ISO / pascal / swag / textwndw.swg / 0001_Execute DOS in a Window.pas next >
Encoding:
Pascal/Delphi Source File  |  1993-05-28  |  9.9 KB  |  362 lines
  1. {$A+,B-,D+,E-,F-,G-,I-,L-,N-,O-,P-,Q-,R-,S-,T-,V-,X+,Y-}
  2. {$M   16384,0,655360}
  3. Unit  ExecWin;
  4. Interface
  5. Var   SaveInt10 : Pointer;
  6.  
  7. Procedure ExecWindow(X1,Y1,X2,Y2,
  8.                      Attr         : Byte;
  9.                      Path,CmdLine : String);
  10.  
  11. Implementation
  12. Uses
  13.   Crt,Dos;
  14. Type
  15.   PageType  = Array [1..50,1..80] of Word;
  16. Var
  17.   Window    : Record
  18.     X1,Y1,X2,Y2,
  19.     Attr         : Byte;
  20.     CurX,CurY    : Byte;
  21.   end;
  22.   Regs      : Registers;
  23.   Cleared   : Boolean;
  24.   Screen    : ^PageType;
  25.   ActPage,
  26.   VideoMode : ^Byte;
  27.   {$ifOPT D+}
  28.   Fnc,
  29.   OldFnc    : Byte;
  30.   {$endif}
  31.  
  32. {$ifOPT D+}
  33. Function FStr(Num : LongInt) : String;
  34. Var
  35.   Dummy : String;
  36. begin
  37.   Str(Num,Dummy);
  38.   FStr := Dummy;
  39. end;
  40.  
  41. Procedure WriteXY(X,Y,Attr : Byte;TextStr : String);
  42. Var
  43.   Loop : Byte;
  44. begin
  45.   if Length(TextStr)>0 then
  46.   begin
  47.     Loop := 0;
  48.     Repeat
  49.       Inc(Loop);
  50.       Screen^[Y,X+(Loop-1)] := ord(TextStr[Loop])+Word(Attr SHL 8);
  51.     Until Loop=Length(TextStr);
  52.   end;
  53. end;
  54. {$endif}
  55.  
  56. Procedure ScrollUp(X1,Y1,X2,Y2,Attr : Byte); Assembler;
  57. Asm
  58.   mov   ah,$06
  59.   mov   al,$01
  60.   mov   bh,Attr
  61.   mov   ch,Y1
  62.   mov   cl,X1
  63.   mov   dh,Y2
  64.   mov   dl,X2
  65.   dec   ch
  66.   dec   cl
  67.   dec   dh
  68.   dec   dl
  69.   int   $10
  70. end;
  71.  
  72. Procedure ClearXY(X1,Y1,X2,Y2,Attr : Byte); Assembler;
  73. Asm
  74.   mov   ah,$06
  75.   mov   al,$00
  76.   mov   bh,Attr
  77.   mov   ch,Y1
  78.   mov   cl,X1
  79.   mov   dh,Y2
  80.   mov   dl,X2
  81.   dec   ch
  82.   dec   cl
  83.   dec   dh
  84.   dec   dl
  85.   int   $10
  86. end;
  87.  
  88. {$ifOPT D+}
  89. Procedure Beep(Freq,Delay1,Delay2 : Word);
  90. begin
  91.   Sound(Freq);
  92.   Delay(Delay1);
  93.   NoSound;
  94.   Delay(Delay2);
  95. end;
  96. {$endif}
  97.  
  98. {$F+}
  99. Procedure NewInt10(Flags,CS,IP,AX,BX,CX,
  100.                    DX,SI,DI,DS,ES,BP : Word); Interrupt;
  101. Var
  102.   X, Y, X1,
  103.   Y1, X2, Y2   : Byte;
  104.   Loop, DummyW : Word;
  105. begin
  106.   SetIntVec($10,SaveInt10);
  107.   {$ifOPT D+}
  108.   Fnc := Hi(AX);
  109.   if Fnc<>OldFnc then
  110.   begin
  111.     WriteXY(1,1,14,'Coordinates:');
  112.     WriteXY(20,1,14,'Register:');
  113.     WriteXY(20,2,14,'AH: '+FStr(Hi(AX))+'  ');
  114.     WriteXY(20,3,14,'AL: '+FStr(Lo(AX))+'  ');
  115.     WriteXY(20,4,14,'BH: '+FStr(Hi(BX))+'  ');
  116.     WriteXY(20,5,14,'BL: '+FStr(Lo(BX))+'  ');
  117.     WriteXY(30,2,14,'CH: '+FStr(Hi(CX))+'  ');
  118.     WriteXY(30,3,14,'CL: '+FStr(Lo(CX))+'  ');
  119.     WriteXY(30,4,14,'DH: '+FStr(Hi(DX))+'  ');
  120.     WriteXY(30,5,14,'DL: '+FStr(Lo(DX))+'  ');
  121.     Case Fnc of
  122.       $0 : WriteXY(40,1,14,'Set video mode.                        ');
  123.       $1 : WriteXY(40,1,14,'Set cursor shape.                      ');
  124.       $2 : WriteXY(40,1,14,'Set cursor position.                   ');
  125.       $3 : WriteXY(40,1,14,'Get cursor position.                   ');
  126.       $4 : WriteXY(40,1,14,'Get lightpen position.                 ');
  127.       $5 : WriteXY(40,1,14,'Set active page.                       ');
  128.       $6 : WriteXY(40,1,14,'Scroll up lines.                       ');
  129.       $7 : WriteXY(40,1,14,'Scroll down lines.                     ');
  130.       $8 : WriteXY(40,1,14,'Get Character/attribute.               ');
  131.       $9 : WriteXY(40,1,14,'Write Character/attribute.             ');
  132.       $A : WriteXY(40,1,14,'Write Character.                       ');
  133.       $D : WriteXY(40,1,14,'Get pixel in Graphic mode.             ');
  134.       $E : WriteXY(40,1,14,'Write Character.                       ');
  135.       $F : WriteXY(40,1,14,'Get video mode.                        ');
  136.       else WriteXY(40,1,14,'(unknown/ignored Function)             ');
  137.     end;
  138.     Case Hi(AX) of
  139.       $0..$E : Beep(Hi(AX)*100,2,5);
  140.           else begin
  141.                  Beep(1000,50,0);
  142.                  Repeat Until ReadKey<>#0;
  143.                end;
  144.     end;
  145.   end;
  146.   {$endif}
  147.   Case Hi(AX) of
  148.     $00 : begin
  149.             ClearXY(Window.X1,Window.Y1,Window.X2,Window.Y2,Window.Attr);
  150.             GotoXY(Window.X1,Window.Y1);
  151.             Window.CurX := Window.X1;
  152.             Window.CurY := Window.Y1;
  153.           end;
  154.     $01 : begin
  155.             Regs.AH := $01;
  156.             Regs.CX := CX;
  157.             Intr($10,Regs);
  158.           end;
  159.     $02 : begin
  160.             X           := Lo(DX);
  161.             Y           := Hi(DX);
  162.             Window.CurX := X+1;
  163.             if Cleared then
  164.             begin
  165.               Window.CurY := Window.Y1;
  166.               Cleared     := False;
  167.             end
  168.             else Window.CurY := Y+1;
  169.             if Window.CurX<=Window.X2 then
  170.             begin
  171.               Regs.AH     := $02;
  172.               Regs.BH     := ActPage^;
  173.               Regs.DL     := X;
  174.               Regs.DH     := Y;
  175.               Intr($10,Regs);
  176.             end;
  177.           end;
  178.     $03 : begin
  179.             Regs.AH     := $03;
  180.             Regs.BH     := ActPage^;
  181.             Intr($10,Regs);
  182.             DX          := (Window.X1-Regs.DL)+((Window.Y1-Regs.DH) SHL 8);
  183.             CX          := Regs.CX;
  184.           end;
  185.     $04 : AX := Lo(AX);
  186.     $06 : begin
  187.             X1      := Window.X1+Lo(CX)-1;
  188.             Y1      := Window.Y1+Hi(CX)-1;
  189.             X2      := Window.X2+Lo(DX)-1;
  190.             Y2      := Window.Y2+Hi(DX)-1;
  191.             if Lo(AX)=0 then
  192.             begin
  193.               ClearXY(Window.X1,Window.Y1,
  194.                       Window.X2,Window.Y2,Window.Attr);
  195.               GotoXY(Window.X1,Window.Y1);
  196.               Window.CurX := Window.X1;
  197.               Window.CurY := Window.Y1;
  198.               Cleared     := True;
  199.             end
  200.             else
  201.             begin
  202.               if X2>Window.X2 then X2 := Window.X2;
  203.               if Y2>Window.Y2 then Y2 := Window.Y2;
  204.               Regs.AH := $06;
  205.               Regs.AL := Lo(AX);
  206.               Regs.CL := X1;
  207.               Regs.CH := Y1;
  208.               Regs.DL := X2;
  209.               Regs.DH := Y2;
  210.               Regs.BH := Window.Attr;
  211.               Intr($10,Regs);
  212.             end;
  213.           end;
  214.     $07 : begin
  215.             X1      := Window.X1+Lo(CX)-1;
  216.             Y1      := Window.Y1+Hi(CX)-1;
  217.             X2      := Window.X2+Lo(DX)-1;
  218.             Y2      := Window.Y2+Hi(DX)-1;
  219.             if X2>Window.X2 then
  220.               X2 := Window.X2;
  221.             if Y2>Window.Y2 then
  222.               Y2 := Window.Y2;
  223.             Regs.AH := $07;
  224.             Regs.AL := Lo(AX);
  225.             Regs.CL := X1;
  226.             Regs.CH := Y1;
  227.             Regs.DL := X2;
  228.             Regs.DH := Y2;
  229.             Regs.BH := Window.Attr;
  230.             Intr($10,Regs);
  231.           end;
  232.     $08 : begin
  233.             Regs.AH := $08;
  234.             Regs.BH := ActPage^;
  235.             Intr($10,Regs);
  236.             AX      := Regs.AX;
  237.           end;
  238.     $09,
  239.     $0A : begin
  240.             Regs.AH := $09;
  241.             Regs.BH := ActPage^;
  242.             Regs.CX := CX;
  243.             Regs.AL := Lo(AX);
  244.             Regs.BL := Window.Attr;
  245.             Intr($10,Regs);
  246.           end;
  247.     $0D : AX := Hi(AX) SHL 8;
  248.     $0D : AX := Hi(AX) SHL 8;
  249.     $0E : begin
  250.             Case Lo(AX) of
  251.                7 : Write(#7);
  252.               13 : begin
  253.                      Window.CurX := Window.X1-1;
  254.                      if Window.CurY>=Window.Y2 then
  255.                      begin
  256.                        Window.CurY := Window.Y2-1;
  257.                        ScrollUp(Window.X1,Window.Y1,
  258.                                 Window.X2,Window.Y2,Window.Attr);
  259.                      end;
  260.                    end;
  261.               else
  262.                 begin
  263.                   Regs.AH := $0E;
  264.                   Regs.AL := Lo(AX);
  265.                   Regs.BL := Window.Attr;
  266.                   Intr($10,Regs);
  267.                 end;
  268.             end;
  269.             Inc(Window.CurX);
  270.             GotoXY(Window.CurX,Window.CurY);
  271.           end;
  272.     $0F : begin
  273.             AX := $03+(80 SHL 8);
  274.             BX := Lo(BX);
  275.           end;
  276.      else
  277.        begin
  278.          Regs.AX    := AX;
  279.          Regs.BX    := BX;
  280.          Regs.CX    := CX;
  281.          Regs.DX    := DX;
  282.          Regs.SI    := SI;
  283.          Regs.DI    := DI;
  284.          Regs.DS    := DS;
  285.          Regs.ES    := ES;
  286.          Regs.BP    := BP;
  287.          Regs.Flags := Flags;
  288.          Intr($10,Regs);
  289.          AX         := Regs.AX;
  290.          BX         := Regs.BX;
  291.          CX         := Regs.CX;
  292.          DX         := Regs.DX;
  293.          SI         := Regs.SI;
  294.          DI         := Regs.DI;
  295.          DS         := Regs.DS;
  296.          ES         := Regs.ES;
  297.          BP         := Regs.BP;
  298.          Flags      := Regs.Flags;
  299.        end;
  300.   end;
  301.   {$ifOPT D+}
  302.   if Fnc<>OldFnc then
  303.   begin
  304.     WriteXY(1,2,14,FStr(Window.CurX)+':'+FStr(Window.CurY)+'  ');
  305.     WriteXY(1,3,14,FStr(Window.CurX-Window.X1+1)+':'+
  306.                    FStr(Window.CurY-Window.Y1+1)+'  ');
  307.     WriteXY(40,2,14,'AH: '+FStr(Hi(AX))+'  ');
  308.     WriteXY(40,3,14,'AL: '+FStr(Lo(AX))+'  ');
  309.     WriteXY(40,4,14,'BH: '+FStr(Hi(BX))+'  ');
  310.     WriteXY(40,5,14,'BL: '+FStr(Lo(BX))+'  ');
  311.     WriteXY(50,2,14,'CH: '+FStr(Hi(CX))+'  ');
  312.     WriteXY(50,3,14,'CL: '+FStr(Lo(CX))+'  ');
  313.     WriteXY(50,4,14,'DH: '+FStr(Hi(DX))+'  ');
  314.     WriteXY(50,5,14,'DL: '+FStr(Lo(DX))+'  ');
  315.     OldFnc := Fnc;
  316.   end;
  317.   {$endif}
  318.   SetIntVec($10,@NewInt10);
  319. end;
  320. {$F-}
  321.  
  322. Procedure ExecWindow;
  323. begin
  324.   Window.X1   := X1;
  325.   Window.Y1   := Y1;
  326.   Window.X2   := X2;
  327.   Window.Y2   := Y2;
  328.   Window.Attr := Attr;
  329.   {$ifOPT D+}
  330.   Fnc         := 255;
  331.   OldFnc      := 255;
  332.   {$endif}
  333.   ClearXY(Window.X1,Window.Y1,
  334.           Window.X2,Window.Y2,Window.Attr);
  335.   GotoXY(Window.X1,Window.Y1);
  336.   Window.CurX := Window.X1;
  337.   Window.CurY := Window.Y1;
  338.   SwapVectors;
  339.   GetIntVec($10,SaveInt10);
  340.   SetIntVec($10,@NewInt10);
  341.   Exec(Path,CmdLine);
  342.   SetIntVec($10,SaveInt10);
  343.   SwapVectors;
  344. end;
  345.  
  346. begin
  347.   Window.X1   := Lo(WindMin);
  348.   Window.Y1   := Hi(WindMin);
  349.   Window.X2   := Lo(WindMax);
  350.   Window.Y2   := Hi(WindMax);
  351.   Window.Attr := TextAttr;
  352.   Window.CurX := WhereX;
  353.   Window.CurY := WhereY;
  354.   Cleared     := False;
  355.   ActPage     := Ptr(Seg0040,$0062);
  356.   VideoMode   := Ptr(Seg0040,$0049);
  357.   if VideoMode^=7 then
  358.     Screen := Ptr(SegB000,$0000)
  359.   else
  360.     Screen := Ptr(SegB800,$0000);
  361. end.
  362.